﻿PHUONG THUC ACCEPT

Private Sub WinsockTCP_ConnectionRequest _
(requestID As Long)
    If Winsock1.State <> sckClosed Then 
Winsock1.Close
Winsock.Accept requestID
End Sub

PHUONG THUC ADD (COLLECTION)

Private Sub Command1_Click()
    Dim MyClasses As New Collection
    Dim Num As Integer
    Dim Msg
    Dim TheName
    Do
       Dim Inst As New Class1
       Num = Num + 1
       Msg = "Please enter a name:" & Chr(13) _
        & "Press Cancel to see names in collection."
       TheName = _
 InputBox(Msg, "Name the Collection Items")
       Inst.instancename = TheName
       If Inst.instancename <> "" Then
          MyClasses.Add Item:=Inst, Key:=CStr(Num)
       End If
       Set Inst = Nothing
    Loop Until TheName = ""
    For Each X In MyClasses
       MsgBox X.instancename, , "Instance Name"
    Next
End Sub

PHUONG THUC ADD (LISTITEMS)

Private Sub Form_Load()
   Dim clmX As ColumnHeader
   Dim itmX As ListItem
   Dim i As Integer

   For i = 1 To 3
      Set clmX = ListView1.ColumnHeaders.Add()
      clmX.Text = "Col" & i
   Next i   

   For i = 1 To 10
      Set itmX = ListView1.ListItems.Add()
      itmX.SmallIcon = 1
      itmX.Text = "ListItem " & i
      itmX.SubItems(1) = "Subitem 1"
      itmX.SubItems(2) = "Subitem 2"
   Next i
End Sub

PHUONG THUC ADD (NODES)

Private Sub Form_Load()
   TreeView1.LineStyle = tvwRootLines
   Dim nodX As Node
   Set nodX = TreeView1.Nodes.Add(, , "r", "Root")

   Set nodX = TreeView1.Nodes.Add("r", _
tvwChild, "child1", "Child")
End Sub

PHUONG THUC ADDITEM

Private Sub Form_Click()
   Dim Entry, I, Msg
   Msg = "Choose OK to add 100 items to your list box."
   MsgBox Msg
   For I = 1 To 100
      Entry = "Entry " & I
      List1.AddItem Entry
   Next I
   Msg = "Choose OK to remove every other entry."
   MsgBox Msg
   For I = 1 To 50
      List1.RemoveItem I
   Next I
   Msg = "Choose OK to remove all items from the list box."
   MsgBox Msg
   List1.Clear
End Sub

PHUONG THUC ARRANGE

Const FORMCOUNT = 5
Dim F(1 To FORMCOUNT) As New Form1
Private Sub MDIForm_Load()
   Dim I
   Load Form1
   For I = 1 To FORMCOUNT
      F(I).Caption = "Form" & I + 1
   Next I
End Sub

Private Sub Picture1_Click()
   Static ClickCount
   Dim I, PrevWidth, Start
   ClickCount = ClickCount + 1
   Select Case ClickCount
      Case 1
         MDIForm1.Arrange 1
      Case 2
         MDIForm1.Arrange 2
      Case 3
         PrevWidth = MDIForm1.Width
         MDIForm1.Width = PrevWidth / 2
         Form1.WindowState = 1
         For I = 1 To FORMCOUNT
F(I).WindowState = 1
Next I
         Start = Timer
         Do
         Loop Until Timer = Start + 5
         MDIForm1.Width = PrevWidth
         MDIForm1.Arrange 3
   End Select
End Sub

PHUONG THUC CANCEL

Private Sub btnGetDir_Click()
   With Inet1
      .URL = "ftp://ftp.learn.huukhang.com/"
      .UserName = "John Smith"
      .Password = "mAuI&9$6"
If .UserName <> "khang" Then
             .Cancel
    Else
             .Execute , "DIR"
         End If
End With
End Sub

PHUONG THUC CELLTEXT

Sub DataGrid1_Scroll(Cancel As Integer)
   Dim TopRow, BottomRow
   TopRow = DataGrid1.Columns(1). _
        CellText(DataGrid1.FirstRow)
    BottomRow = DataGrid1.Columns(1). _
        CellText(DataGrid1.RowBookmark _
        (DataGrid1.VisibleRows - 1))
    Label1.Caption = "Records " & TopRow & " to " & _
    BottomRow & " are currently displayed."
End Sub

PHUONG THUC CELLVALUE

Sub Command1_Click()
   Dim I
   ReDim CalcArray(0 To DataGrid1.SelBookmarks.Count - 1)
   For I = 0 To DataGrid1.SelBookmarks.Count - 1
      CalcArray(I) = _
       DataGrid1.Columns(1). _
            CellValue(DataGrid1.SelBookmarks(I))
   Next I
End Sub

PHUONG THUC CIRCLE

Private Sub Command1_Click()
    Dim CX, CY, Radius, Limit
   ScaleMode = 3
   CX = ScaleWidth / 2
   CY = ScaleHeight / 2
   If CX > CY Then Limit = CY Else Limit = CX
   For Radius = 0 To Limit
   Circle (CX, CY), Radius, RGB(Rnd * 255,  _
Rnd * 255, Rnd * 255)
   Next Radius
End Sub

PHUONG THUC CLEAR

Private Sub Command1_Click()
    On Error GoTo errm
    Dim myCon As New ADODB.Connection
    Dim myRst As New ADODB.Recordset
    Dim myStr As String
    myStr = "Provider=Microsoft.Jet." & _ 
"OLEDB.4.0;Data Source=C:\Program " & _ 
" Files\Microsoft Office" & _
    "\Office\Samples\Northwind.mdb"
     myStr = "driver={SQL Server};server=dinh;" & _
    " Database=Northwind;UID=sa;PWD="

    myCon.Open myStr
    myRst.CursorType = adOpenDynamic
    myRst.LockType = adLockOptimistic
    myRst.Open myStr, myCon
    If myRst.RecordCount > 0 Then
        myRst.Edit
        myRst("CompanyName") = txtName
        myRst("ContactTitle") = txtDesc
        myRst.Update
    End If
    Set myRst = Nothing
    Set myCon = Nothing
    Exit Sub
errm:
    Beep
    MsgBox Error
    err.Clear
End Sub

PHUONG THUC CLOSE

Private Sub Command1_Click()
    On Error GoTo errm
    Dim myCon As New ADODB.Connection
    Dim myRst As New ADODB.Recordset
    Dim myStr As String
    myStr = "Provider=Microsoft.Jet." & _ 
"OLEDB.4.0;Data Source=C:\Program " & _ 
" Files\Microsoft Office" & _
    "\Office\Samples\Northwind.mdb"
     myStr = "driver={SQL Server};server=dinh;" & _
    " Database=Northwind;UID=sa;PWD="

    myCon.Open myStr
    myRst.CursorType = adOpenDynamic
    myRst.LockType = adLockOptimistic
    myRst.Open myStr, myCon
    If myRst.RecordCount > 0 Then
        myRst.Edit
        myRst("CompanyName") = txtName
        myRst("ContactTitle") = txtDesc
        myRst.Update
    End If
    myRst.Close
    myCon.Close
    Set myRst = Nothing
    Set myCon = Nothing
    Exit Sub
errm:
    Beep
    MsgBox Error
End Sub

PHUONG THUC CLOSE

Private Sub cmdDis_Click()
    tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
     tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
    If tcpServer.State <> sckClosed Then _
    tcpServer.Close
    tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()
    
    tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
    Dim strData As String
    tcpServer.GetData strData
    txtOutput.Text = strData
End Sub

PHUONG THUC CLS

Private Sub Command1_Click()
   Dim Msg
   AutoRedraw = -1
   ForeColor = QBColor(15)
   BackColor = QBColor(1)
   FillStyle = 7
   Line (0, 0)-(ScaleWidth, ScaleHeight), , B
   Msg = "This is information printed on the form background."
   CurrentX = ScaleWidth / 2 - TextWidth(Msg) / 2

   CurrentY = 2 * TextHeight(Msg)
Print Msg
     Msg = "OK to clear the info and background "
   Msg = Msg & "pattern just displayed on the form."
   MsgBox Msg
   Cls
End Sub

PHUONG THUC COLLAPSEALL

Private Sub ExpandOrCollapse(flx As MSHFlexGrid)
   Static IsExpanded As Boolean
   If IsExpanded Then
      flx.CollapseAll
      IsExpanded = False
   Else
      flx.ExpandAll
      IsExpanded = True
   End If
End Sub

Private Sub Form_Load()
   ExpandOrCollapse MSHFlexGrid1
End Sub

Private Sub cmdExpandOrCollapse()
   ExpandOrCollapse MSHFlexGrid1
End Sub

PHUONG THUC COPYFILE

Sub Command1_Click()
    Dim fs, f, s
    Set fs = _
         CreateObject("Scripting.FileSystemObject")
        fs.CopyFile Text1, "D:\" & Text1
        
End Sub

PHUONG THUC COPYFOLDER

Sub Command1_Click()
    Dim fs, f, s
    Set fs = _
         CreateObject("Scripting.FileSystemObject")
        fs.CopyFolder Text1, "D:\" & Text1
        
End Sub

PHUONG THUC CREATFOLDER

Sub Command1_Click()
    Dim fs, f, s
    Set fs = _
         CreateObject("Scripting.FileSystemObject")
        fs.CreateFolder("D:\" & Text1)
        
End Sub

PHUONG THUC CREATETEXTFILE

Private Sub Command1_Click()
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    Set a = _
fs.CreateTextFile("c:\testfile.txt", True)
    a.WriteLine ("This is a test.")
    a.Close
End Sub

PHUONG THUC DELETE

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
     CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("C:\ekhang")
    Set fc = f.Files
    For Each f1 In fc
       f1.Delete
    Next
End Sub

PHUONG THUC DELETEFILE

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    If fs.fileExists("D:\test.txt") = True Then
        fs.deletefile ("D:\test.txt")
    End If
End Sub

PHUONG THUC DELETEFOLDER

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    If fs.folderExists("D:\testing") = True Then
        fs.deletefolder ("D:\testing")
    End If
End Sub
PHUONG THUC DRIVEEXISTS

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    If fs.driveExists("F:\") = True Then
        fs.deletefolder ("F:\testing")
    End If
End Sub

PHUONG THUC EXECUTE

Private Sub btnGetHTMLDoc_Click()
   With Inet1
      .URL = "http://www.huukhang.com/"
      .Document = " popupsubcribe.htm "
      .Execute , "GET"
   End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
   Dim strHTML As String
   Dim vtData As String
   Select Case state
   Case icResponseCompleted
      vtData = Inet1.GetChunk(1024, icString)
      Do While LenB(vtData) > 0
         strHTML = strHTML & vtData
         vtData = Inet1.GetChunk(1024, icString)
     Loop
      txtHTML.Text = strHTML
   End Select
End Sub

PHUONG THUC EXISTS

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.Dictionary")
    If fs.Exists("F:\") = True Then
        fs.deletefolder ("F:\testing")
    End If
End Sub

PHUONG THUC EXPANDALL

Private Sub ExpandOrCollapse(flx As MSHFlexGrid)
   Static IsExpanded As Boolean
   If IsExpanded Then
      flx.CollapseAll
      IsExpanded = False
   Else
      flx.ExpandAll
      IsExpanded = True
   End If
End Sub

Private Sub Form_Load()
   ExpandOrCollapse MSHFlexGrid1
End Sub

Private Sub cmdExpandOrCollapse()
   ExpandOrCollapse MSHFlexGrid1
End Sub

PHUONG THUC EXPORTREPORT

Private Sub ExportDailyReport()
   DataReport1.Title = "Daily Report"
   Dim strTemplate As String
   strTemplate = _
   "" & vbCrLf & _
   "" & vbCrLf & _
   "" & vbCrLf & _
   "" & vbCrLf & _
   rptTagBody & vbCrLf & _
   "" & vbCrLf & _
   ""
   
   DataReport1.ExportFormats.Add _
   Key:="DailyReport", _
   FormatType:=rptFmtHTML, _
   FileFormatString:="Daily Report (*.htm)", _
   FileFilter:="*.HTM", _
   Template:=strTemplate
   
   DataReport1.ExportReport _
   FormatIndexOrKey:="DailyReport", _
   FileName:="C:\Temp\DailyRpt", _
   Overwrite:=True, _
   ShowDialog:=False, _
   Range:=rptRangeFromTo, _
   Pagefrom:=1, _
   Pageto:=10
End Sub

PHUONG THUC FILEEXISTS

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    If fs.fileExists("D:\test.txt") = True Then
        fs.deletefile ("D:\test.txt")
    End If
End Sub

PHUONG THUC FILES

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    If fs.folderExists("D:\testing") = True Then
        fs.deletefolder ("D:\testing")
    End If
End Sub

PHUONG THUC GETABSOLUTEPATHNAME

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    Debug.Print _
fs.GetAbsolutePathName("inetpub")
‘D:\Program Files\Microsoft Visual Studio\VB98\inetpub
End Sub

PHUONG THUC GETBASENAME

Private Sub Command1_Click()
    Dim fs, f, f1, fc, s
    Set fs = _
    CreateObject("Scripting.FileSystemObject")
    Debug.Print _
fs.GetBaseName("wwwroot\test.php")
‘ keát quaû traû veà laø: test
End Sub

PHUONG THUC GETCHUNK

Private Sub btnGetHTMLDoc_Click()
   With Inet1
      .URL = "http://www.huukhang.com/"
      .Document = " popupsubcribe.htm "
      .Execute , "GET"
   End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
   Dim strHTML As String
   Dim vtData As String
   Select Case state
   Case icResponseCompleted
      vtData = Inet1.GetChunk(1024, icString)
      Do While LenB(vtData) > 0
         strHTML = strHTML & vtData
         vtData = Inet1.GetChunk(1024, icString)
     Loop
      txtHTML.Text = strHTML
   End Select
End Sub

PHUONG THUC GETDATA

Private Sub cmdDis_Click()
    tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
     tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
    If tcpServer.State <> sckClosed Then _
    tcpServer.Close
    tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()
    
    tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
    Dim strData As String
    tcpServer.GetData strData
    txtOutput.Text = strData
End Sub

PHUONG THUC GETDRIVE

Private Sub Command1_Click()
   Dim fso, d, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   Set d = _
   fso.GetDrive(fso.GetDriveName("C:\inetpub"))
   s = "Drive " & UCase(drvPath) & " - "
   s = s & d.VolumeName & "
"
   s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
   s = s & " Kbytes"
   Debug.Print s
End Sub

PHUONG THUC GETDRIVENAME

Private Sub Command1_Click()
   Dim fso, d, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   Set d = _
   fso.GetDrive(fso.GetDriveName("C:\inetpub"))
   s = "Drive " & UCase(drvPath) & " - "
   s = s & d.VolumeName & "
"
   s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
   s = s & " Kbytes"
   Debug.Print s
End Sub

PHUONG THUC GETEXTENSIONNAME

Private Sub Command1_Click()
   Dim fso, d, s
   Set fso = _
   CreateObject("Scripting.FileSystemObject")
   s = fso.Getextensionname("C:\text.txt")
   Debug.Print s
End Sub

PHUONG THUC GETFILE

Private Sub Command1_Click()
   Dim fso, f, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFile("C:\test.txt")
   s = f.Path & "
"
   s = s & "Created: " & f.DateCreated & "
"
   s = s & "Last Accessed: " & _
f.DateLastAccessed & "
"
   s = s & "Last Modified: " & f.DateLastModified
   Debug.Print s
End Sub

PHUONG THUC GETFILENAME

Private Sub Command1_Click()
   Dim fso, f, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   s = fso.GetFilename("C:\test.txt")
   Debug.Print s
End Sub

PHUONG THUC GETFOLDER

Private Sub Command1_Click()
   Dim fso, f, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder("C:\inetpub\wwwroot")
   s = f.Path & "
"
   s = s & "Created: " & f.DateCreated & "
"
   s = s & "Last Accessed: " & _
f.DateLastAccessed & "
"
   s = s & "Last Modified: " & f.DateLastModified
   Debug.Print s
End Sub

PHUONG THUC GETPARENTFOLDERNAME

Private Sub Command1_Click()
   Dim fso, f, s
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   s = _
fso.GetParentFolderName( _
"C:\inetpub\default.htm")
   Debug.Print s
   s = fso.GetParentFolderName("C:\inetpub\")
   Debug.Print s
End Sub

PHUONG THUC HIDE

Private Sub btnClose_Click()
    Form1.Hide
End Sub

PHUONG THUC ITEMS

Private Sub Command1_Click()
    Dim a, d, i
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "Athens"
    d.Add "b", "Belgrade"
    d.Add "c", "Cairo"
    a = d.Items
    For i = 0 To d.Count - 1
        Debug.Print a(i)
    Next
End Sub

PHUONG THUC KEYS

Private Sub Command1_Click()
    Dim a, d, i
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "Athens"
    d.Add "b", "Belgrade"
    d.Add "c", "Cairo"
    a = d.keys
    For i = 0 To d.Count - 1
        Debug.Print a(i)
    Next
End Sub

PHUONG THUC MOVE

Private Sub Form_Click()
   Dim Inch, Msg
   Msg = "Choose OK to resize and move this form by "
   Msg = Msg & "changing the value of properties."
   MsgBox Msg
   Inch = 1440
   Width = 4 * Inch
   Height = 2 * Inch
   Left = 0
   Top = 0
   Msg = "Now choose OK to resize & move this form "
   Msg = Msg & "using the Move method."
   MsgBox Msg
   Move Screen.Width - 2 * Inch, _
    Screen.Height - Inch, 2 * Inch, Inch
End Sub

PHUONG THUC MOVEFILE

Private Sub Command1_Click()
   Dim fso
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   fso.MoveFile "C:\test.txt",  _
"c:\windows\desktop\"
End Sub

PHUONG THUC MOVEFOLDER

Private Sub Command1_Click()
   Dim fso
   Set fso = _
    CreateObject("Scripting.FileSystemObject")
   fso.MoveFolder "C:\test\ ",  _
"c:\windows\desktop\"
End Sub

PHUONG THUC OPEN

Private Sub Animation1_Click()
   With CommonDialog1
      .Filter = "avi (*.avi)|*.avi"
      .ShowOpen
   End With
   With Animation1
      .AutoPlay = True
      .Open CommonDialog1.FileName
   End With
End Sub

PHUONG THUC OPENTEXTFILE

Const ForReading = 1, ForWriting = 2
Const ForAppending = 3
Private Sub Command1_Click()
    Dim fs, f
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", _
        ForAppending, TristateFalse)
    f.Write "Hello world!"
    f.Close
End Sub

PHUONG THUC OPENURL

Private Sub Command1_Click()
    Dim b() As Byte
    Dim strURL As String
    strURL = "FTP://ftp.GreatSite.com/China.exe"
    b() = Inet1.OpenURL(strURL, icByteArray)
    
    Open "C:\Temp\China.exe" For Binary Access _
    Write As #1
    Put #1, , b()
    Close #1
End Sub

PHUONG THUC POPUPMENU

Private Sub Form_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
      PopupMenu mnFile
   End If
End Sub

PHUONG THUC PRINTREPORT

Private Sub DisplayPrintDialog()
   DataReport1.PrintReport True
End Sub

Private Sub PrintWithoutDialog()
   DataReport1.PrintReport False, _
rptRangeAllPages
End Sub

PHUONG THUC READALL

Private Sub Command1_Click()
    Dim fs, f
    Dim s As String
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
    s = f.Readall
    Debug.Print s
    f.Close
End Sub

PHUONG THUC READLINE

Private Sub Command1_Click()
    Dim fs, f
    Dim s As String
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
    s = f.ReadLine
    Debug.Print s
    f.Close
End Sub

PHUONG THUC REFRESH

Private Sub Form_Load()
    Me.Refresh
End Sub

PHUONG THUC REMOVEALL

Private Sub Command1_Click()
    Dim a, d, i
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "Athens"
    d.Add "b", "Belgrade"
    d.Add "c", "Cairo"
    a = d.keys
    For i = 0 To d.Count - 1
        Debug.Print a(i)
    Next
    d.RemoveAll
End Sub

PHUONG THUC REMOVEITEM

Private Sub Form_Click()
   Dim Entry, I, Msg
   Msg = "Choose OK to add 100 items to your list box."
   MsgBox Msg
   For I = 1 To 100
      Entry = "Entry " & I
      List1.AddItem Entry
   Next I
   Msg = "Choose OK to remove every other entry."
   MsgBox Msg
   For I = 1 To 50
      List1.RemoveItem I
   Next I
   Msg = "Choose OK to remove all items from the list box."
   MsgBox Msg
   List1.Clear
End Sub

PHUONG THUC SAVEFILE

Private Sub Command1_Click()
   CommonDialog1.ShowSave
   RichTextBox1.SaveFile _
CommonDialog1.FileName, rtfRTF
End Sub

PHUONG THUC SCROLL

Sub ScrollDownRight_Click()
   DataGrid1.Scroll DataGrid1.VisibleCols, _
DataGrid1.VisibleRows
End Sub

Sub ScrollUpLeft_Click()
   DataGrid1.Scroll -DataGrid1.VisibleCols, _
-DataGrid1.VisibleRows
End Sub

PHUONG THUC SENDDATA

Private Sub cmdDis_Click()
    tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
     tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
    If tcpServer.State <> sckClosed Then _
    tcpServer.Close
    tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()
    
    tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
    Dim strData As String
    tcpServer.GetData strData
    txtOutput.Text = strData
End Sub

PHUONG THUC SETFOCUS

Private Sub Form_Load()
    Me.ttNo.SetFocus
End Sub

PHUONG THUC SHOW

Private Sub Form_Load()
frmLogin.Show 1
End Sub

PHUONG THUC SHOWCOLOR

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowColor
End Sub

PHUONG THUC SHOWFONT

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowFont
End Sub

PHUONG THUC SHOWHELP

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowHelp
End Sub

PHUONG THUC SHOWOPEN

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowOpen
End Sub

PHUONG THUC SHOWPRINTER

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowPrinter
End Sub

PHUONG THUC SHOWSAVE

Private Sub cmdShow_Click()
    Me. CommonDialog1.ShowSave
End Sub

PHUONG THUC SKIPLINE

Private Sub Command1_Click()
    Dim fs, f
    Dim s As String
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
    s = f.ReadLine
    if InStr(s,”:”) >0 then
f.skipline
    end if
    Debug.Print s
    f.Close
End Sub

PHUONG THUC STOP

Private Sub Animation1_Click()
   With CommonDialog1
      .Filter = "avi (*.avi)|*.avi"
      .ShowOpen
   End With
   With Animation1
      .AutoPlay = True
      .Open CommonDialog1.FileName
      .Stop
   End With
End Sub

PHUONG THUC UPDATE

Private Sub Command1_Click()
    On Error GoTo errm
    Dim myCon As New ADODB.Connection
    Dim myRst As New ADODB.Recordset
    Dim myStr As String
    myStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    " Data Source=C:\Program Files\Microsoft Office" & _
    "\Office\Samples\Northwind.mdb"
     myStr = "driver={SQL Server};server=dinh;" & _
    " Database=Northwind;UID=sa;PWD="

    myCon.Open myStr
    myRst.CursorType = adOpenDynamic
    myRst.LockType = adLockOptimistic
    myRst.Open myStr, myCon
    If myRst.RecordCount > 0 Then
        myRst.Edit
        myRst("CompanyName") = txtName
        myRst("ContactTitle") = txtDesc
        myRst.Update
    End If
    Set myRst = Nothing
    Set myCon = Nothing
    Exit Sub
errm:
    Beep
    MsgBox Error
    Err.Clear
End Sub

PHUONG THUC WRITE

Private Sub Command1_Click()
    Dim fs, f
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", _
        1, TristateFalse)
    f.Write "Hello world!"
    f.Close
End Sub

PHUONG THUC WRITELINE

Private Sub Command1_Click()
    Dim fs, f
    Set fs = _
      CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\testfile.txt", _
        1, TristateFalse)
    f.WriteLine "Hello world!"
    f.Close
End Sub







